home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tptc17sc.zip / TPCSYM.INC < prev    next >
Text File  |  1988-03-26  |  7KB  |  290 lines
  1.  
  2. (*
  3.  * TPTC - Turbo Pascal to C translator
  4.  *
  5.  * (C) 1988 Samuel H. Smith (rev. 13-Feb-88)
  6.  *
  7.  *)
  8.  
  9. (********************************************************************)
  10. function findsym( table: symptr;
  11.                   id:    string40): symptr;
  12.    {locate a symbol in a specified symbol table.  returns pointer to
  13.     the entry if found, otherwise nil is returned}
  14. var
  15.    sym: symptr;
  16.    
  17. begin
  18.    stoupper(id);
  19.    
  20.    sym := table;
  21.    while sym <> nil do
  22.    begin
  23.  
  24.       if sym^.id[1] = id[1] then             {for speed, try first char}
  25.       if length(sym^.id) = length(id) then   {... then verify length}
  26.       if sym^.id = id then                   {... finally compare strings}
  27.       begin
  28.          findsym := sym;    {symbol found}
  29.          exit;
  30.       end;
  31.  
  32.       sym := sym^.next;
  33.    end;
  34.  
  35.    findsym := nil;   {symbol not found}
  36. end;
  37.  
  38.  
  39. (********************************************************************)
  40. function locatesym(id:    string40): symptr;
  41.    {locate a symbol in either the local or the global symbol table.
  42.     returns the symbol table entry pointer, if found.  returns
  43.     nil when not in either table}
  44. var
  45.    sym: symptr;
  46.  
  47. begin
  48.    if id[1] = '^' then
  49.       delete(id,1,1);
  50.       
  51.    sym := findsym(locals,id);
  52.    if sym = nil then
  53.       sym := findsym(globals,id);
  54.  
  55.    locatesym := sym;
  56. end;
  57.  
  58.  
  59. (********************************************************************)
  60. procedure addsym( var table: symptr;
  61.                   id:        string40;
  62.                   symtype:   symtypes;
  63.                   suptype:   supertypes;
  64.                   parcount:  integer;
  65.                   varmap:    integer;
  66.                   lim:       integer;
  67.                   base:      integer;
  68.                   dup_ok:    boolean);
  69.    {add a symbol to a specific symbol table.  duplicates hide prior entries.
  70.     new symbol pointed to by cursym}
  71. begin
  72.    if maxavail-300 < sizeof(cursym^) then
  73.    begin
  74.       ltok := id;
  75.       fatal('Out of memory');
  76.    end;
  77.  
  78.    if (not dup_ok) and (not in_interface) then
  79.    begin
  80.       cursym := findsym(table,id);
  81.       if cursym <> nil then
  82.       begin
  83.          ltok := id;
  84.          if (cursym^.parcount <> parcount) or 
  85.             (cursym^.symtype <> symtype) or (cursym^.limit <> lim) then
  86.             warning('Redeclaration not identical');
  87.          ltok := tok;
  88.       end;
  89.    end;
  90.    
  91.    new(cursym);
  92.    cursym^.next := table;
  93.    table := cursym;
  94.  
  95.    cursym^.repid := decl_prefix + id;
  96.    stoupper(id);
  97.    cursym^.id := id;
  98.    cursym^.symtype := symtype;
  99.    cursym^.suptype := suptype;
  100.    cursym^.parcount := parcount;
  101.    cursym^.limit := lim;
  102.    cursym^.base := base;
  103.    cursym^.pvar := varmap;
  104. end;
  105.  
  106.  
  107. (********************************************************************)
  108. procedure newsym( id:       string40;
  109.                   symtype:  symtypes;
  110.                   suptype:  supertypes;
  111.                   parcount: integer;
  112.                   varmap:   integer;
  113.                   lim:      integer;
  114.                   base:     integer);
  115.    {enter a new symbol into the current symbol table (local or global)}
  116. begin
  117.    if (unitlevel = 0) or (in_interface) then
  118.       addsym(globals,id,symtype,suptype,parcount,varmap,lim,base,false)
  119.    else
  120.       addsym(locals,id,symtype,suptype,parcount,varmap,lim,base,true);
  121. end;
  122.  
  123.  
  124.  
  125. (********************************************************************)
  126. procedure dumptable(sym: symptr; top: symptr);
  127.    {dump entries from the specified symbol table, stopping where indicated}
  128. var
  129.    info: string40;
  130.    
  131. begin
  132.       
  133.    if (not dumpsymbols) or (sym = nil) or (sym = top) then
  134.       exit;
  135.  
  136.    {putline;}
  137.    putln('/* User symbols:');
  138.    putln(' *    Class        Type        Base   Limit Pars  Pvar   Identifier');
  139.    putln(' *   ------------ ------------ ----- ------ ---- ------ --------------');
  140.    
  141.    while (sym <> nil) and (sym <> top) do
  142.    begin
  143.    
  144.       if sym^.repid = '<predef>' then
  145.       begin
  146.          if dumppredef then
  147.          begin
  148.             putln(' *');
  149.             putln(' * Predefined symbols:');
  150.             putln(' *    Class        Type        Base   Limit Pars  Pvar   Identifier');
  151.             putln(' *   ------------ ------------ ----- ------ ---- ------ --------------');
  152.          end
  153.          else
  154.             sym := nil;
  155.       end
  156.       else
  157.       
  158.       begin         
  159.          write(ofd[unitlevel],' *    ',
  160.            ljust(supertypename[sym^.suptype],13),
  161.            ljust(typename[sym^.symtype],12),
  162.            sym^.base:5,' ',
  163.            sym^.limit:6,' ',
  164.            sym^.parcount:4,' ',
  165.            sym^.pvar:6,'   ',
  166.            sym^.repid);
  167.          putline;
  168.       end;
  169.  
  170.       if sym <> nil then
  171.          sym := sym^.next;
  172.    end;
  173.  
  174.    putln(' */');
  175.    putline;
  176. end;
  177.  
  178.  
  179. (********************************************************************)
  180. procedure purgetable( var table: symptr; top: symptr);
  181.    {purge all entries from the specified symbol table}
  182. var
  183.    sym: symptr;
  184.  
  185. begin
  186.    dumptable(table, top);
  187.    
  188.    while (table <> nil) and (table <> top) do
  189.    begin
  190.       sym := table;
  191.       table := table^.next;
  192.  
  193.       {if sym^.suptype = ss_const then
  194.          putln('#undef '+sym^.repid);}
  195.          
  196.       dispose(sym);
  197.    end;
  198. end;
  199.  
  200.  
  201. (********************************************************************)
  202. procedure create_unitfile(name: string64; sym, top: symptr);
  203.    {dump symbol table to the specified unit symbol file}
  204. var
  205.    fd:      text;
  206.    outbuf:  array[1..inbufsiz] of byte;
  207.    
  208. begin
  209.    assign(fd,name);
  210. {$I-}
  211.    rewrite(fd);
  212. {$I+}
  213.    if ioresult <> 0 then
  214.    begin
  215.       ltok := name;
  216.       fatal('Can''t create unit symbol file');
  217.    end;
  218.    
  219.    setTextBuf(fd,outbuf);
  220.  
  221.    while (sym <> nil) and (sym <> top) do
  222.    begin
  223.       writeln(fd,sym^.id);
  224.       writeln(fd,sym^.repid);
  225.       writeln(fd,ord(sym^.suptype),' ',
  226.                  ord(sym^.symtype),' ',
  227.                  sym^.base,' ',
  228.                  sym^.limit,' ',
  229.                  sym^.parcount,' ',
  230.                  sym^.pvar);
  231.       
  232.       inc(objtotal,3);
  233.       sym := sym^.next;
  234.    end;
  235.  
  236.    close(fd);
  237. end;
  238.  
  239.  
  240. (********************************************************************)
  241. procedure load_unitfile(name: string64; var table: symptr);
  242.    {load symbol table fromthe specified unit symbol file}
  243. var
  244.    fd:      text;
  245.    sym:     symptr;
  246.    sstype:  byte;
  247.    stype:   byte;
  248.    inbuf:   array[1..inbufsiz] of byte;
  249.       
  250. begin
  251.    assign(fd,name);
  252.    {$I-} reset(fd); {$I+}
  253.    if ioresult <> 0 then
  254.    begin
  255.       name := symdir + name;
  256.       assign(fd,name);
  257.       {$I-} reset(fd); {$I+}
  258.    end;
  259.    
  260.    if ioresult <> 0 then
  261.    begin
  262.       ltok := name;
  263.       fatal('Can''t open unit symbol file');
  264.    end;
  265.    
  266.    setTextBuf(fd,inbuf);
  267.    
  268.    while not eof(fd) do
  269.    begin
  270.       new(sym);
  271.       sym^.next := table;
  272.       table := sym;
  273.       
  274.       readln(fd,sym^.id);
  275.       readln(fd,sym^.repid);
  276.       readln(fd,sstype,stype,
  277.                 sym^.base,
  278.                 sym^.limit,
  279.                 sym^.parcount,
  280.                 sym^.pvar);
  281.  
  282.       sym^.suptype := supertypes(sstype);
  283.       sym^.symtype := symtypes(stype);
  284.    end;
  285.  
  286.    close(fd);
  287. end;
  288.  
  289.  
  290.